home *** CD-ROM | disk | FTP | other *** search
/ Aminet 51 / Aminet 51 (2002)(GTI - Schatztruhe)[!][Oct 2002].iso / Aminet / dev / misc / FlexCat.lha / Lib / HSPascalUnit.sd < prev    next >
Encoding:
Text File  |  1999-11-28  |  3.6 KB  |  179 lines
  1. ##rem $Id: HSPascalUnit.sd,v 1.2 1999/11/28 03:36:41 carlos Exp $
  2. ##shortstrings
  3. ##stringtype E
  4. UNIT %bLocale;
  5. INTERFACE
  6.  
  7. {****************************************************
  8.  
  9.   This file was created automatically by '%fv'
  10.   from "%f0".
  11.  
  12.   Do NOT edit by hand!
  13.  
  14. ****************************************************}
  15.  
  16. USES
  17.   Exec , Locale , Utility ;
  18.  
  19. CONST
  20.   %i = %d ;\n  %i_STR = %s%[#0;\n
  21.  
  22. PROCEDURE CloseCatalog;
  23.  
  24. PROCEDURE OpenCatalog(loc : pLocale ; language : STRPTR ) ;
  25.  
  26. FUNCTION GetString(num : LONGINT) : STRPTR ;
  27.  
  28. FUNCTION GetPasString(num : LONGINT) : STRING;
  29.  
  30. IMPLEMENTATION 
  31.  
  32. CONST
  33.   builtinlanguage = %l%[#0;
  34.   version = %v ;
  35.   catalog  : pCatalog = NIL ;
  36.  
  37. VAR
  38.  
  39.   OldExitProc : Pointer;
  40.  
  41. TYPE
  42.  
  43.   tAppString = RECORD
  44.      id  : LONGINT ;
  45.      str : STRPTR ;
  46.   END ;
  47.  
  48.   tAppStringArray = ARRAY [0..%n] OF tAppString ;
  49.  
  50. CONST
  51.   AppStrings : tAppStringArray = (( id : 0 ; str : NIL ));  
  52.  
  53. FUNCTION CPtr( s : string ):pointer;INLINE
  54.   $201F, { move.l (a7)+,d0 ; get address string }
  55.   $5280, { addq.l #1,d0    ; ignore counter }
  56.   $2E80; { move.l d0,(a7)  ; return "C-string" address }
  57.  
  58. PROCEDURE CloseCatalog;
  59. BEGIN
  60.   IF catalog <> NIL THEN
  61.     BEGIN
  62.       Locale.CloseCatalog(catalog) ;
  63.       catalog := NIL
  64.     END;
  65. END; 
  66.  
  67. PROCEDURE InitAppStringsArray;
  68. BEGIN
  69.   AppStrings[%d].id := %i;\n  AppStrings[%d].str := CPtr(%i_STR);\n
  70. END;
  71.  
  72. PROCEDURE OpenCatalog(loc : pLocale ; language : STRPTR );
  73. VAR
  74.    tags   : ARRAY [0..7] OF LONGINT ;
  75. BEGIN
  76.   CloseCatalog;
  77.   IF (catalog = NIL) AND (LocaleBase <> NIL) THEN
  78.     BEGIN
  79.       IF language <> NIL THEN
  80.         BEGIN
  81.           tags[0] := OC_BuiltInLanguage; tags[1] := long(CPtr(builtinlanguage));
  82.           tags[2] := OC_Language ;       tags[3] := long(language); 
  83.           tags[4] := OC_Version ;        tags[5] := version;
  84.           tags[6] := TAG_END;
  85.         END
  86.       ELSE
  87.         BEGIN
  88.           tags[0] := OC_BuiltInLanguage; tags[1] := long(CPtr(builtinlanguage));
  89.           tags[2] := OC_Version ;        tags[3] := version;
  90.           tags[4] := TAG_END;
  91.         END;
  92.     catalog := Locale.OpenCatalogA(loc, CPtr('%b.catalog'#0), @tags) ;
  93.     END 
  94. END;
  95.  
  96. FUNCTION GetString(num : LONGINT) : STRPTR ;
  97.  
  98. VAR
  99.   i       : LONGINT ;
  100.   default : STRPTR ;
  101.  
  102. BEGIN
  103.   i := 0 ;
  104.  
  105.   WHILE (i < %n) AND (AppStrings[i].id <> num) DO
  106.   BEGIN
  107.     INC(i)
  108.   END ;
  109.  
  110.   IF i <> %n THEN
  111.     default := AppStrings[i].str
  112.    ELSE
  113.     default := NIL ;
  114.  
  115.   IF catalog <> NIL THEN
  116.     GetString := Locale.GetCatalogStr(catalog, num, default)
  117.    ELSE
  118.     GetString := default
  119. END;
  120.  
  121. FUNCTION GetPasString(num : LONGINT) : STRING;
  122. TYPE
  123.   pa = ^ta;
  124.   ta = PACKED ARRAY [0..MAXINT] OF CHAR;
  125. VAR
  126.   i    : INTEGER;
  127.   sptr : pa;
  128.   s    : STRING;
  129. BEGIN
  130.   sptr := pa(GetString( num ));
  131.   s := '';
  132.   i := 0;
  133.   WHILE sptr^[i] <> #0 DO 
  134.   BEGIN
  135.     s := s + sptr^[i];
  136.     INC(i)
  137.   END;
  138.   GetPasString := s
  139. END;
  140.  
  141. (***************************************************************************)
  142. (*                  << INIT AND EXIT PROCEDURE  >>                         *)
  143. (***************************************************************************)
  144.  
  145. PROCEDURE InitFunction;
  146. BEGIN
  147.   LocaleBase := OpenLibrary( 'locale.library' , 38 );
  148.   if LocaleBase = NIL then 
  149.     BEGIN
  150.       WRITELN( '*** ERROR *** locale.library ' );
  151.       HALT
  152.     END;
  153.   InitAppStringsArray;
  154.   OpenCatalog( NIL , NIL );
  155. END;
  156.  
  157. PROCEDURE ExitFunction;
  158. BEGIN
  159.   if LocaleBase <> NIL then CloseLibrary( LocaleBase );
  160.   CloseCatalog;
  161. END;
  162.  
  163. PROCEDURE ExitHandler;
  164. BEGIN
  165.   ExitProc := OldExitProc;
  166.   ExitFunction;
  167. END;
  168.  
  169. PROCEDURE Initialize;
  170. BEGIN
  171.   OldExitProc := ExitProc;
  172.   ExitProc := @ExitHandler;
  173.   InitFunction;
  174. END;
  175.  
  176. BEGIN
  177.   Initialize;
  178. END.
  179.